home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / toolfix.arc / SORT2.PAS < prev    next >
Pascal/Delphi Source File  |  1985-08-07  |  9KB  |  290 lines
  1. {$C-}
  2. program SortMultipleFiles;
  3. {
  4.   TURBO DATABASE TOOLBOX DEMONSTRATION PROGRAM:
  5.  
  6.   How to write a sort routine that can select which file of records
  7.   to sort.
  8.  
  9.   Modified:  08/07/85
  10.  
  11.   This program takes the CUSTOMER.DTA and the  STOCK.DTA files,  sorts
  12.   the one requested by the user and displays the sorted records on the
  13.   screen.
  14. }
  15.  
  16. type
  17.   NameString = string[25];
  18.   CustRec = record
  19.               Number: integer;
  20.               Name:   NameString;
  21.               Addr:   string[20];
  22.               City:   string[12];
  23.               State:  string[3];
  24.               Zip:    string[5];
  25.             end;
  26.   ItemRec = record
  27.               Number:  integer;
  28.               Descrip: string[30];
  29.               InStock: integer;
  30.               Price:   real;
  31.             end;
  32.  
  33. var
  34.   CustFile  : file of CustRec;
  35.   Customer  : CustRec;
  36.   StockFile : file of ItemRec;
  37.   Item      : ItemRec;
  38.   Choice    : char;
  39.   Results   : integer;
  40.  
  41. {$I SORT.BOX }
  42.  
  43. procedure ClrEOS(Y : byte);
  44. { Clear the screen from row Y to 25, then place cursor
  45.   on column 1, row Y.
  46. }
  47. var i : integer;
  48. begin
  49.   for i := Y to 25 do
  50.   begin
  51.     GoToXY(1, i);
  52.     ClrEOL;
  53.   end;
  54.   GoToXY(1, Y);
  55. end; { ClrEOS }
  56.  
  57. procedure OpenFile(var Choice : char);
  58. { Set up screen, select which file to sort, open data file }
  59.  
  60. procedure Menu(var Choice : char);
  61. { Set up screen, select which file to sort. }
  62. begin
  63.   ClrScr;
  64.   Writeln('TURBO-SORT DEMONSTRATION PROGRAM':56);
  65.   Writeln;
  66.   Writeln;
  67.   Writeln;
  68.   Writeln('Turbo-Sort is fast!   This program will ring the');
  69.   Writeln('bell when the sort starts and then ring it again');
  70.   Writeln('when the sort is finished.');
  71.   Writeln;
  72.   Writeln;
  73.   Writeln('Sort');
  74.   Writeln('----');
  75.   Writeln;
  76.   Writeln('Customer file');
  77.   Writeln('Stock File');
  78.   Writeln;
  79.   Write('Enter C or S: ');
  80.   repeat
  81.     Read(KBD, Choice);
  82.     if Choice in [^C, #27] then Halt;    { abort program }
  83.     Choice := UpCase(Choice);
  84.   until Choice in ['C','S'];
  85.   ClrEOS(3);
  86.   case Choice of                         { draw header   }
  87.     'C' : begin
  88.             Writeln('     No.  Company Name               Address',
  89.                     '              City      State Zip');
  90.             Writeln('---  ---- -------------------------  ',
  91.                     '-------------------- ------------ -- -----');
  92.             Writeln;
  93.           end; { C }
  94.     'S' : begin
  95.             Writeln(' ':10,
  96.                     '     No.  Description                     ',
  97.                     '  Qty   Price');
  98.             Writeln(' ':10,
  99.                     '---  ---- ------------------------------  ',
  100.                     '----- -------');
  101.             Writeln;
  102.           end; { C }
  103.   end; { case }
  104. end; { Menu }
  105.  
  106. begin { OpenFiles }
  107.   Menu(Choice);
  108.   Writeln;
  109.   Writeln('Opening data file');
  110.   case Choice of
  111.     'C': begin
  112.            Assign(CustFile,'CUSTOMER.DTA');
  113.            {$I-}
  114.            Reset(CustFile);
  115.          end;
  116.     'S': begin
  117.            Assign(StockFile,'STOCK.DTA');
  118.            {$I-}
  119.            Reset(StockFile);
  120.          end;
  121.   end; {case}
  122.   {$I+}
  123.   if IOresult <> 0 then
  124.   begin
  125.     Writeln('  -- Cannot find data file.');
  126.     Halt;                                      { abort program }
  127.   end;
  128. end; { OpenFile }
  129.  
  130. procedure Inp;
  131. { This procedure is forward declared in SORT.BOX.    It sends
  132.   a stream of records to the sort routine.  It also keeps the
  133.   user informed of how many records have been read.
  134. }
  135. var
  136.   rec : integer;
  137. begin
  138.   rec := 0;
  139.   Writeln;
  140.   case Choice of
  141.     'C': begin
  142.            Writeln('Input routine -- sending ', FileSize(CustFile),
  143.                    ' records to sort:');
  144.            repeat
  145.              rec := rec + 1;
  146.              Write(#13, rec:6);
  147.              Read(CustFile,Customer);
  148.              SortRelease(Customer);
  149.            until EOF(CustFile);
  150.            Writeln;
  151.            Writeln;
  152.            Writeln('Done with input -- sorting ',
  153.                     FileSize(CustFile),
  154.                     ' records . . .', ^G);             { ring bell }
  155.          end; { C }
  156.     'S': begin
  157.            Writeln('Input routine -- sending ', FileSize(StockFile),
  158.                    ' records to sort:');
  159.            repeat
  160.              rec := rec + 1;
  161.              Write(#13, rec:6);
  162.              Read(StockFile,Item);
  163.              SortRelease(Item);
  164.            until EOF(StockFile);
  165.            Writeln;
  166.            Writeln;
  167.            Writeln('Done with input -- sorting ',
  168.                     FileSize(StockFile),
  169.                     ' records . . .', ^G);             { ring bell }
  170.          end; { S }
  171.   end; { case }
  172. end; { Inp }
  173.  
  174. function Less;
  175. { This boolean function specifies sort priority.    It is
  176.   forward declared in SORT.BOX and has two parameters,  X
  177.   and  Y.    Record X is sorted "lower" than Y based on a
  178.   comparison  between  the fields specified below  (Name,
  179.   Customer  number,  etc.).   Because  this  function  is
  180.   called many times,   the number  of  statements in this
  181.   function should be kept to a minimum.
  182. }
  183. var
  184.   FirstCust:  CustRec absolute X;  { customer file }
  185.   SecondCust: CustRec absolute Y;
  186.   FirstItem:  ItemRec absolute X;  { stock file    }
  187.   SecondItem: ItemRec absolute Y;
  188. begin
  189.   case Choice of         { define sort priority }
  190.     'C': Less := FirstCust.Number < SecondCust.Number;
  191.     'S': Less := (FirstItem.InStock < SecondItem.InStock) or
  192.                 ((FirstItem.InStock = SecondItem.InStock) and
  193.                  (FirstItem.Price < SecondItem.Price));
  194.   end;
  195. end; { Less }
  196.  
  197. procedure OutP;
  198. { This procedure is forward declared in SORT.BOX.    It
  199.   retrieves the sorted objects  one-by-one and displays
  200.   them on the screen.  NOTE:  If your terminal does not
  201.   provide  support  for  deleting  a line,  you  should
  202.   modify the Scroll procedure below.
  203. }
  204. var
  205.   i, Line : integer;
  206.  
  207. procedure Scroll(Line : integer);
  208. { This procedure controls scrolling during output of records.
  209.   If your terminal does not support line delete, substitute a
  210.   single Writeln statement for the IF statement below.
  211. }
  212. begin
  213.   if Line > 20 then
  214.   begin
  215.     GoToXY(1, 5);      { first line below header }
  216.     DelLine;
  217.     GoToXY(1, 24);     { last line on screen     }
  218.   end
  219.   else
  220.   begin
  221.     GoToXY(1, Line + 4);
  222.   end;
  223. end; { Scroll }
  224.  
  225. begin
  226.   Write(^G);      { ring bell -- finished w/ sort!        }
  227.   ClrEOS(5);      { clear from line 5 to end of screen    }
  228.   Line := 1;      { init line count                       }
  229.   case Choice of  { retrieve records from sort & display  }
  230.     'C' : begin
  231.             repeat
  232.               if KeyPressed then Halt;  { Key touched?  Stop program }
  233.               Scroll(Line);
  234.               SortReturn(Customer);
  235.               with Customer do
  236.               begin
  237.                 Write(Line:3, Number:6, ' ', Name,' ');
  238.                 for i := Length(Name) to 25 do Write(' ');
  239.                 Write(Addr);
  240.                 for i := Length(Addr) to 20 do Write(' ');
  241.                 Write(City);
  242.                 for i := Length(City) to 12 do Write(' ');
  243.                 Write(State,' ', Zip);
  244.               end; { with }
  245.               Line := Line + 1;
  246.             until SortEOS;
  247.           end; { C }
  248.     'S' : begin
  249.             repeat
  250.               if KeyPressed then Halt;  { Key touched?  Stop program }
  251.               SortReturn(Item);
  252.               Scroll(Line);
  253.               with Item do
  254.               begin
  255.                 Write(Line:13, Number:6, ' ', Descrip,' ');
  256.                 for i := Length(Descrip) to 30 do Write(' ');
  257.                 Write(InStock:5, Price:8:2);
  258.               end;
  259.               Line := Line + 1;
  260.             until SortEOS;
  261.           end; { S }
  262.   end; { case }
  263.   Scroll(25);                        { make room for results message }
  264.   Scroll(25);
  265.   Scroll(25);
  266. end; { OutP }
  267.  
  268. procedure DisplayResults(Results : integer);
  269. begin
  270.   case Results of                         { display sort results     }
  271.      0 : Write('Done with sort and display.');
  272.      3 : Write('Error:  not enough memory to sort');
  273.      8 : Write('Error:  illegal item length.');
  274.      9 : Write('Error:  can only sort ', MaxInt, ' records.');
  275.     10 : Write('Error:  disk full or disk write error.');
  276.     11 : Write('Error:  disk error during read.');
  277.     12 : Write('Error:  directory full or invalid path name');
  278.   end; { case }
  279. end; { DisplayResults }
  280.  
  281. begin { program body }
  282.   OpenFile(Choice);                       { open data file to sort   }
  283.   case Choice of                          { sort the file of records }
  284.     'C' : Results := TurboSort(SizeOf(CustRec));     { customer file }
  285.     'S' : Results := TurboSort(SizeOf(ItemRec));     { stock file    }
  286.   end; { case }
  287.   DisplayResults(Results);                { display sort results     }
  288. end.
  289.  
  290.